Developer CD Series 1992 June: ROMin Holiday/ADC Developer CD (1992-06) (''ROMin Holiday'')_iso/Developer Connection - 06-1992.iso/Developer Essentials/DTS Sample Code/System 7.0 Samples/ProcDoggie 1.0a6⁄THINK P/UEmergMem.p

Text File | 1991-02-21 | 17.0 KB | 452 lines | [TEXT/PJMM]

unit UEmergMem;

{-------------------------------------------------------------------------------}
{#}
{#    Apple Macintosh Developer Technical Support}
{#}
{#    Interfaces for the emergency memory routines}
{#}
{#    Program:    ProcDoggie}
{#    File:        UEmergMem.p - Pascal Implementation}
{#}
{#    by:        Forrest Tanaka}
{#}
{#    Copyright © 1988-1991 Apple Computer, Inc.}
{#    All rights reserved.}
{#}
{--------------------------------------------------------------------------------}
{#}
{# EmergMem contains routines to handle emergency memory situations.  This is}
{# used for Toolbox routines that either don’t check for memory-full errors, or}
{# that call _SysErr when they can’t allocate the memory that they need.  The}
{# purpose of the routines in this unit is to make sure that these toolbox}
{# routines always get the memory they need.}
{#}
{-------------------------------------------------------------------------------}
{[j=20/57/1$] Pasmat Options}

{-------------------------------------------------------------------------------}
{#}
{#     2/21/91 pvh - THINK Pascal conversion.}
{#    Notes:}
{#}
{#}
{-------------------------------------------------------------------------------}

interface


(*******************************************************************************}
{* Used Units}
{*******************************************************************************)

    uses
        (* Group 1 *)
        Types, QuickDraw,

        (* Group 2 *)
        Memory, OSUtils;


(*******************************************************************************}
{* Constants}
{*******************************************************************************)

    const
        kAllocApp = TRUE; {For NewPtrMargin/NewHandleMargin for app heap alloc}
        kAllocClr = TRUE; {For NewPtrMargin/NewHandleMargin to clear mem block}


(*******************************************************************************}
{* ConnectAppGZ - Connect the application grow zone proc}
{*}
{* This routine is called whenever this application’s simple grow-zone procedure}
{* (see UEmergMem.inc1.p for the source for the grow-zone procedure) is to be}
{* connected.  From this point on, any requests for memory by this application or}
{* the system invoke our grow-zone procedure if there isn’t enough memory to}
{* satisfy the request.}
{*******************************************************************************)

    procedure ConnectAppGZ;


(*******************************************************************************}
{* DisconnectAppGZ - Disconnect the application grow zone proc}
{*}
{* This routine is called whenever this application’s simple grow-zone procedure}
{* (see EmergMem.inc1.p for the source for the grow-zone procedure) is to be}
{* disconnected.  From this point on, any requests for memory by this application}
{* or the system return memFullErr if there isn’t enough memory to satisfy the}
{* request.}
{*******************************************************************************)

    procedure DisconnectAppGZ;


(*******************************************************************************}
{* InitEmergMem - Allocate emergency memory}
{*}
{* This is called at startup time to allocate the emergency memory block that’s}
{* deallocated in the grow zone procedure (this application’s grow-zone procedure}
{* is a privately-declared procedure defined in UEmergMem.inc1.p).  InitEmergMem}
{* also installs this application’s grow-zone proc.}
{*}
{* If there isn’t enough memory to allocate the block of emergency memory, then}
{* a subsequent call to FailLowMemory(0) returns TRUE.}
{*******************************************************************************)

    procedure InitEmergMem;


(*******************************************************************************}
{* NoEmergMem - Check to see if emergency memory is being used or not}
{*}
{* Before my application attempts to use more memory, I call this routine to}
{* check if I'm already using my emergency memory.  If so, then I’d better}
{* prepare to die or get my emergency memory back.}
{*******************************************************************************)

    function NoEmergMem: Boolean;


(*******************************************************************************}
{* RecoverEmergMem - Recover emergency memory}
{*}
{* This is called from the event loop if NoEmergMem indicates that the emergency}
{* memory was deallocated by this application’s grow-zone procedure.  This}
{* routine will attempt recover the emergency memory.  If this fails, then some}
{* usually some application options and commands are disabled until there is}
{* enough free memory to enable them again.}
{*******************************************************************************)

    procedure RecoverEmergMem;


(*******************************************************************************}
{* FailLowMemory - Is there enough free space in heap to allocate memory?}
{*}
{* FailLowMemory is called any time a potentially significant amount of non-}
{* temporary memory is about to be allocated.  It returns TRUE if there’s enough}
{* free space in the heap to allocate the requested amount of memory and still}
{* have a significant amount of free space left over, and if the emergency memory}
{* isn’t being used.  See UEmergMem.inc1.p for the definition of “significant}
{* amount.”  "memRequest" specifies the number of bytes that are about to be}
{* allocated.}
{*}
{* This routine is also used even if the amount of memory about to be allocated}
{* isn’t clear.  In this case, it’s called after the significant amount of memory}
{* is allocated and 0 is passed in memRequest.  If FailLowMemory returns TRUE,}
{* then there’s was enough memory for the requested amount and still leave 32K}
{* free and the emergency memory allocated.  If FailLowMemory returns FALSE, then}
{* either there isn’t 32K free, or the emergency memory was deallocated by this}
{* application’s grow-zone procedure, or both.  This is actually the usual way}
{* that I use this function, because I normally use it for calls to the Toolbox,}
{* and there’s usually no reliable way to determine how much memory the Toolbox}
{* is going to allocate.}
{*******************************************************************************)

    function FailLowMemory (memRequest: LongInt): Boolean;



(*******************************************************************************}
{* NewHandleMargin - Create a new handle without using emergency memory}
{*}
{* Many toolbox routines simply call SysErr when they run out of memory.  That’s}
{* not too cool, so I try to make certain that the memory they need is always}
{* available by making sure that I never request so much memory that the toolbox}
{* routines are in danger of running out of memory and calling SysErr.  This is}
{* achieved by calling NewHandleMargin instead of NewHandle any time a}
{* relocatable memory block is desired.  NewHandle returns memFullErr in MemErr}
{* if there isn’t enough free contiguous space to satisfy the request and still}
{* leave a significant amount of free memory.}
{*}
{* NewHandleMargin returns NIL if there isn’t enough memory to allocated a block}
{* of the size specified by "requestedSize".}
{*}
{* If "appHeapAlloc" is kAppHeap, then the block of memory is allocated in the}
{* application’s heap.  If "appHeapAlloc" is NOT kAppHeap, then the block of}
{* memory is allocated in the system heap.}
{*}
{* If "clearMem" is kAllocClr, then all the bytes in the block of memory are}
{* cleared to zero.  If NOT kAllocClr is passed, then none of the bytes in the}
{* block of memory are touched after being allocated.}
{*******************************************************************************)

    function NewHandleMargin (requestedSize: Size; appHeapAlloc: Boolean; clearMem: Boolean): Handle;


(*******************************************************************************}
{* NewPtrMargin - Create a new pointer without using emergency memory}
{*}
{* Many toolbox routines simply call SysErr when they run out of memory.  That’s}
{* not too cool, so I try to make certain that the memory they need is always}
{* available by making sure that I never request so much memory that the toolbox}
{* routines are in danger of running out of memory and calling SysErr.  This is}
{* achieved by calling NewPtr instead of NewHandle any time a non-relocatable}
{* memory block is desired.  NewHandle returns memFullErr in MemErr if there}
{* isn’t enough free contiguous space to satisfy the request and still leave a}
{* significant amount of free memory.}
{*}
{* NewptrMargin returns NIL if there isn’t enough memory to allocated a block of}
{* the size specified by "requestedSize".}
{*}
{* If "appHeapAlloc" is kAppHeap, then the block of memory is allocated in the}
{* application’s heap.  If "appHeapAlloc" is NOT kAppHeap, then the block of}
{* memory is allocated in the system heap.}
{*}
{* If "clearMem" is kAllocClr, then all the bytes in the block of memory are}
{* cleared to zero.  If NOT kAllocClr is passed, then none of the bytes in the}
{* block of memory are touched after being allocated.}
{*******************************************************************************)

    function NewPtrMargin (requestedSize: Size; appHeapAlloc: Boolean; clearMem: Boolean): Ptr;


implementation

(*******************************************************************************}
{* Constants}
{*******************************************************************************)

    const
        kEmergMemSize = 32768; {Number of bytes of emergency memory to allocate}
        kMemoryMargin = 32768; {Minimum amount of free memory I allow in the heap}


(*******************************************************************************}
{* Global Variables}
{*******************************************************************************)

    var
        gEmergMem: Handle; {Handle to block of emergency memory}


{$S Main}
(*******************************************************************************}
{* Private: AppGrowZone - Custom grow-zone procedure}
{*}
{* This is a very basic grow zone procedure.  My application keeps a reserve}
{* handle of memory in case the Memory Manager gets a request for some memory}
{* that is not available in my heap.  If memory were to get tight (<32k), the}
{* Toolbox will crash the system.  This grow-zone proc tries to thwart that}
{* possibility by releasing the 32K block of emergency memory if it hasn’t been}
{* released already and if the amount of memory requested is less than 32K.}
{* Hopefully, that’s enough to satisfy the memory request.}
{*}
{* There are three conditions in which the emergency memory isn’t freed.  If the}
{* emergency memory is already free, obviously there isn’t much that can be done.}
{* If the emergency memory is equal to GZSaveHnd, then it was the reallocation of}
{* emergency memory that caused this grow-zone proc to be called.  So it doesn’t}
{* make much sense to free it in that case.  If the size of the memory request is}
{* more than the size of emergency memory, then I don’t bother to free emergency}
{* memory because I assume that the toolbox handles such huge requests for memory}
{* properly.  Warning: that isn’t always a good assumption, but that’s not my}
{* fault.}
{*}
{*     WARNING: Register A5 might not be valid when grow-zone procedures}
{*     are called. Read Technical Note #136 and 208.}
{*}
{* The "cbNeeded" parameter is the number of bytes that the Memory Manager needs}
{* to fulfill the memory request it had received.  The number of bytes actually}
{* freed by AppGrowZone is returned.}
{*******************************************************************************)


    function AppGrowZone (cbNeeded: Size): LongInt;

        var
            theA5: LongInt; {Value of A5 when AppGrowZone is called}

    begin
        (* Remember the current value of A5 *)
        theA5 := SetCurrentA5;

        (* Free emergency memory if possible *)
        if (gEmergMem^ <> nil) & (gEmergMem <> GZSaveHnd) & (cbNeeded <= kEmergMemSize) then
            begin
                EmptyHandle(gEmergMem);
                AppGrowZone := kEmergMemSize
            end
        else
            AppGrowZone := 0;

        (* Restore A5 *)
        theA5 := SetA5(theA5)
    end;


{$S Main}
(*******************************************************************************}
{* Public: ConnectAppGZ}
{*}
{* It’s pretty self-explanatory.}
{*******************************************************************************)

    procedure ConnectAppGZ;

    begin
        SetGrowZone(@AppGrowZone)
    end;


{$S Main}
(*******************************************************************************}
{* Public: DisconnectAppGZ}
{*}
{* It’s pretty self-explanatory.}
{*******************************************************************************)

    procedure DisconnectAppGZ;

    begin
        SetGrowZone(nil)
    end;


{$S %A5Init}
(*******************************************************************************}
{* Public: InitEmergMem}
{*}
{* It’s pretty self-explanatory.}
{*******************************************************************************)

    procedure InitEmergMem;

    begin
        gEmergMem := NewHandle(kEmergMemSize);
        ConnectAppGZ
    end;


{$S Main}
(*******************************************************************************}
{* Public: NoEmergMem}
{*}
{* We check on the handle and the master pointer of gEmergMem to see if the}
{* emergency memory block has been emptied by AppGrowZone, or was never allocated}
{* in the first place.}
{*******************************************************************************)

    function NoEmergMem: Boolean;

    begin
        (* Empty handle means no emergency memory *)
        NoEmergMem := (gEmergMem = nil) | (gEmergMem^ = nil)
    end;


{$S Main}
(*******************************************************************************}
{* Public: RecoverEmergMem}
{*}
{* Not much to describe.}
{*******************************************************************************)

    procedure RecoverEmergMem;

    begin
        ReallocHandle(gEmergMem, kEmergMemSize);
    end;


{$S Main}
(*******************************************************************************}
{* Public: FailLowMemory}
{*}
{* PurgeSpace is used to determine how much free memory there’d be in the heap if}
{* all purgeable blocks were purged.  If this amount is less than the amount}
{* needed, or if there isn’t any emergency memory, TRUE is returned.}
{*******************************************************************************)

    function FailLowMemory (memRequest: LongInt): Boolean;

        var
            total: LongInt; {Total amount of free memory if heap was purged}
            contig: LongInt; {Max amount of free contiguous memory if heap was purged}

    begin
        PurgeSpace(total, contig);(*<*)
 (*<*)
        FailLowMemory := (total < (memRequest + kMemoryMargin)) | NoEmergMem
    end;


{$S Main}
(*******************************************************************************}
{* Public: NewHandleMargin}
{*}
{* I don’t call SysError with an ID 25 if there isn’t enough memory to satisfy}
{* the request, so there isn’t much reason to use the grow-zone proc.  So, I}
{* disconnect the grow-zone proc temporarily just before I allocate the memory.}
{*******************************************************************************)

    function NewHandleMargin (requestedSize: Size; appHeapAlloc: Boolean; clearMem: Boolean): Handle;

        var
            total: LongInt; {Total free bytes after a theoretical heap purge/compaction}
            contig: LongInt; {Largest contig free block from theoretical heap purge/compaction}

    begin
        if FailLowMemory(requestedSize) then
            NewHandleMargin := nil
        else
            begin
                (* We handle memFullErr properly, so don’t need grow-zone proc *)
                DisconnectAppGZ;

                (* Allocate the memory with the requested options *)
                if (not appHeapAlloc) and clearMem then
                    NewHandleMargin := NewHandleSysClear(requestedSize)
                else if (not appHeapAlloc) then
                    NewHandleMargin := NewHandleSys(requestedSize)
                else if clearMem then
                    NewHandleMargin := NewHandleClear(requestedSize)
                else
                    NewHandleMargin := NewHandle(requestedSize);

                (* Connect up the grow-zone proc again *)
                ConnectAppGZ
            end
    end;


{$S Main}
(*******************************************************************************}
{* Public: NewPtrMargin}
{*}
{* I don’t call SysError with an ID 25 if there isn’t enough memory to satisfy}
{* the request, so there isn’t much reason to use the grow-zone proc.  So, I}
{* disconnect the grow-zone proc temporarily just before I allocate the memory.}
{*******************************************************************************)

    function NewPtrMargin (requestedSize: Size; appHeapAlloc: Boolean; clearMem: Boolean): Ptr;

        var
            total: LongInt; {Total free bytes after a theoretical heap purge/compaction}
            contig: LongInt; {Largest contig free block from theoretical heap purge/compaction}

    begin
        if FailLowMemory(requestedSize) then
            NewPtrMargin := nil
        else
            begin
                (* We handle memFullErr properly, so don’t need grow-zone proc *)
                DisconnectAppGZ;

                (* Allocate the memory with the requested options *)
                if (not appHeapAlloc) and clearMem then
                    NewPtrMargin := NewPtrSysClear(requestedSize)
                else if not appHeapAlloc then
                    NewPtrMargin := NewPtrSys(requestedSize)
                else if clearMem then
                    NewPtrMargin := NewPtrClear(requestedSize)
                else
                    NewPtrMargin := NewPtr(requestedSize);

                (* Connect up the grow-zone proc again *)
                ConnectAppGZ
            end
    end;

end.